perm filename FILLX.FAI[NEW,LCS]2 blob sn#153820 filedate 1975-04-09 generic text, type T, neo UTF8
	TITLE FILL
	ENTRY FILLER,LINES,PLOT,PLOTS
	DEFINE FLOAT(N)
   <	TLC N,232000
	FADR N,N   >
	DEFINE FIXX(N)
  <	JUMPGE	N,.+5
	MOVNS	N
	FIX 	N,233000    
	MOVNS	N
	CAIA
	FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.

	KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
	RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
	HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15

				;	SUBROUTINE FILLER(Q,M)
FILLER:	0
	MOVEM 16,SV16#
	HRRZ J,(16)
	HRRZM J,SVQ#
	HRRZ T,@1(16)
	HRRZM T,SVM#		;	KK=NE(1)
	HRRZ KK,2(J)
	ADDI KK,-1(J)
				;	DO 4 K=2,KK
	HRRZI L,2(J)
				;	IF(NE(K).NE.3)GO TO 11
L4:	ADDI L,3
	HRRZ T,(L)
L11:	SETZM (L)
	CAIN T,3
				;	NE(K)=-1
      	SETOM (L)
				;	GO TO 4
				; 11	NE(K)=0
				; 4	CONTINUE
	CAIGE L,(KK)
	JRST L4
				;	RLFT=10000
	MOVE RL,[=10000.0]
				;	RT=-10000
	MOVN RJ,[=10000.0]
				;	B=RT
	MOVE B,RJ
				;	DO 12 K=1,KK
	HRRZI L,-3(J)
				;	H=IFIX(Q(K))
L12:	ADDI L,3
	MOVE H,(L)
	FIXX(H)
	FLOAT(H)
				;	IF(H.LT.RLFT)RLFT=H
	CAMGE H,RL
	MOVE RL,H

				;	IF(H.GT.RT)RT=H
	CAMLE H,RJ
	MOVE RJ,H
				;	IF(H.EQ.B)NE(K)=-1
	CAMN H,B
	SETOM 2(L)
				;	B=H
	MOVE B,H
				;	Q(K)=H
	MOVEM H,(L)
				; 12    R(K)=IFIX(R(K))
	MOVE T,1(L)
	FIXX(T)
	FLOAT(T)
	MOVEM T,1(L)
	CAIGE L,-2(KK)
	JRST L12
				;	NE(KK+1)=-1
	SETOM 3(KK)

				;	LRT=RT
	FIXX(RJ)
	MOVEM RJ,LRT#
				;	JA=3
	HRRZI T,3
	HRRZM T,JA#


				; 124   LEFT=RLFT
L124:	MOVE LE,RL
	FIXX(LE)
				; 51    J=LEFT
L51:	MOVE J,LE
				; 42    RJ=J+.001
L42:	MOVE RJ,J
	FLOAT(RJ)
	FADR RJ,[=0.001]
				;	JCONT=0
	SETZM JCONT#
				;	LEFT=J
	MOVE LE,J

				;	JJ=-1
	SETO JJ,
				;	ALT=-10000.
	MOVN AL,[=10000.0]
				; 200   DO 45 L=2,KK
	HRRZ L,SVQ
L45:	ADDI L,3
	CAILE L,-2(KK)
	JRST L455
				;	IF(NE(L).NE.0)GO TO 45
	SKIPE 2(L)
	JRST L45
				;	IF(MISS(L,RJ,Q))GO TO 45
	CAML RJ,-3(L)
	JRST L201
	CAMLE RJ,(L)
	JRST L202
L201:	CAMGE RJ,(L)
	CAMG RJ,-3(L)
	JRST L45
				;	H=HGHT(L,RJ,Q,R)
L202:	MOVE H,-2(L)
	CAMN H,1(L)
	JRST RET
	MOVNS H
	FADR H,1(L)
	MOVE D,-3(L)
	MOVNS T,D
	FADR T,RJ
	FADR D,(L)
	FMPR H,T
	FDVR H,D
	FADR H,-2(L)
				;	IF(H.LT.ALT)GO TO 45
RET:	CAMGE H,AL
	JRST L45

				;	ALT=H
	MOVE AL,H
				;	JJ=L
	HRRZI JJ,(L)
				; 45    CONTINUE
	JRST L45
				;	IF(JJ)GO TO 43
L455:	JUMPL JJ,L43
				;	JCONT=-1
	SETOM JCONT
				;	LEFT=J
	MOVE LE,J
				; 46    JA=3
L46:	HRRZI T,3
	HRRZM T,JA
				;	JORD=-1
	SETOM JORD#
				; 52    KN=Q(JJ)
L52:	MOVE T,(JJ)
	FIXX(T)
	MOVEM T,KN#
				;	KL=Q(JJ-1)
	MOVE T,-3(JJ)
	FIXX(T)

	MOVEM T,KL#
				;	IF(KN.LT.KL)KN=KL
	CAMLE T,KN
	MOVEM T,KN
				; 50    I=J
L50:	MOVEM J,I#
				; 102   RJ=I+.01
L102:	MOVE RJ,I
	FLOAT(RJ)
	FADR RJ,[=0.01]
				;	ALT=HGHT(JJ,RJ,Q,R)
	MOVE AL,-2(JJ)
	CAMN AL,1(JJ)
	JRST RET2
	MOVNS AL
	FADR AL,1(JJ)
	MOVE D,-3(JJ)
	MOVNS T,D
	FADR T,RJ
	FADR D,(JJ)
	FMPR AL,T
	FDVR AL,D
	FADR AL,-2(JJ)
				;	B=-10000
RET2:	MOVN B,[=10000.0]
				;	JK=-1
	SETO JK,
				;	XALT=ALT+.001
	MOVE T,AL
	FADR T,[=0.001]
	MOVEM T,XALT#

				;	ZALT=ALT
	MOVEM AL,ZALT#
				; 400   DO 47 L=2,KK
	MOVE L,SVQ
L47:	ADDI L,3
	CAILE L,-2(KK)
	JRST L477
			;	IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
	CAME L,JJ
	SKIPGE 2(L)
	JRST L47
	CAML RJ,-3(L)
	JRST L475
	CAMLE RJ,(L)
	JRST L476
L475:	CAMGE RJ,(L)
	CAMG RJ,-3(L)
	JRST L47
				;	H=HGHT(L,RJ,Q,R)
L476:	MOVE H,-2(L)
	CAMN H,1(L)
	JRST RET3
	MOVNS H
	FADR H,1(L)
	MOVE D,-3(L)
	MOVNS T,D
	FADR T,RJ
	FADR D,(L)
	FMPR H,T
	FDVR H,D
	FADR H,-2(L)
				;	IF(H.GT.XALT)GO TO 47
RET3:	CAMG H,XALT

				;	IF(H.LE.B)GO TO 47
	CAMG H,B
	JRST L47
				;	B=H
	MOVE B,H
				;	JK=L
	HRRZI JK,(L)
				; 47    CONTINUE
	JRST L47
				;	IF(JK)GO TO 48
L477:	JUMPL JK,L48
				;	300   IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
	MOVN T,B
	FADR T,ZALT
	CAMG T,[=0.001]
	CAME J,I
	JRST L59
				;	JX=Q(JK)
	MOVE T,(JK)
	FIXX(T)
				;	IF(JX.GT.KN)GO TO 60
	CAMLE T,KN
	JRST L60
				;	JX=Q(JK-1)
	MOVE T,-3(JK)
	FIXX(T)
				;	IF(JX.LT.KN)GO TO 59
	CAMGE T,KN
	JRST L59
				; 60    L=JJ
L60:	MOVE L,JJ
				;	JJ=JK
	MOVE JJ,JK
				;	JK=L
	MOVE JK,L
				;	KN=JX
	MOVEM T,KN

				; 59    IF(ALT-B.LT.2)GO TO 62
L59:	MOVN T,B
	FADR T,AL
	CAMGE T,[=2.0]
	JRST L62
				;	ALT=ALT-1
	HRLZI T,576400
	FADR AL,T
				;	B=B+1
	HRLZI T,201400
	FADR B,T
				; 62    IF(JORD)GO TO 103
L62:	SKIPGE JORD
	JRST L103
				;	H=B
	MOVE H,B
				;	B=ALT
	MOVE B,AL
				;	ALT=H
	MOVE AL,H
				;	IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3

	CAMN JK,NK#
	JRST L103
	MOVN T,B
	FADR T,AL
	SKIPGE T
	MOVNS T
	CAMG T,[5.0]
	JRST L103
	HRRZI T,3
	HRRZM T,JA
				; 103   CALL LINES(RJ,ALT,JA)
L103:	MOVEM RJ,SVRJ#
	MOVEM AL,SVAL#
	MOVEM B,SVB#
	HRRZI 16,SVAC
	BLT 16,SVAC+15
	JSA 16,LINES
	JUMP SVRJ
	JUMP SVAL
	JUMP JA
				; 100   CALL LINES(RJ,B,2)	
	JSA 16,LINES
	JUMP SVRJ
	JUMP SVB 
	JUMP [2]
	HRLZI 16,SVAC
	BLT 16,15
				;	NK=JK
	MOVEM JK,NK

				;	JORD=-JORD
	MOVNS JORD
				;	NE(JK)=1
	HRRZI T,1
	HRRZM T,2(JK)
				;	NE(JJ)=-1
	SETOM 2(JJ)
				;	JA=2
	HRRZI T,2
	HRRZM T,JA
				;	I=I+M
	MOVE T,SVM
	ADDB T,I
				;	IF(I.LT.KN)GO TO 102
	CAMGE T,KN
	JRST L102
				;	L=1
	HRRZI L,3
				;	IF(KN.EQ.KL)L=-1
	MOVE T,KN
	CAMN T,KL
	HRROI L,-3
				;	JJ=JJ+L
	ADD JJ,L
				;	J=0
	SETZ J,
				;	IF(L)J=-1
	SKIPGE L
	HRROI J,-3
		;	IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
	SKIPN 2(JJ)
	CAILE JJ,-2(KK)
	JRST L124
	ADD T,SVM
	FLOAT(T)
	HRRZI HG,(JJ)
	ADD HG,J
	CAMLE T,(HG)
	JRST L124
				;	J=I
	MOVE J,I
				;	GO TO 52
	JRST L52
				; 48    JA=3
L48:	HRRZI T,3
	HRRZM T,JA
				; 43    J=LEFT+M
L43:	MOVE J,LE
	ADD J,SVM
				;	IF(J.LE.LRT)GO TO 42
	CAMG J,LRT
	JRST L42
				;	IF(JCONT)GO TO 51
	SKIPGE JCONT
	JRST L51		;	END
	MOVE 16,SV16
	JRA 16,2(16)
SVAC:	BLOCK 16

	EXTERNAL DST,PLTR,DPY
		;	SUBROUTINE LINES(A,B,L)
		;	COMMON/DST/BB,CC
   		;	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
		;	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
		;	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
		;	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
		;	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
		;	1,(JJ2,JJ(2))
		;	DATA BB/.008/,CC/3.5/
 		;C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
	
	M←2 ↔ NX←3 ↔ K←4

LINES:	0
			;	GO TO 23
	JRST L23
			;22	IF(JQ(1).NE.0)GO TO 23
L22:	SKIPE PLTR+=27
	JRST L23
			;	IF(CC.EQ.1000)GO TO 23
	MOVSI T,212764
	CAMN T,DST+1
	JRST L23
			;	B=B*(CC-BB*ABS(A))
	MOVE T,@(16)
	MOVMS	T
	FMPR T,DST
	FSBR T,DST+1
	FMPRM T,@1(16)
	MOVNS @1(16)
			;23	IF(IPLT)GO TO 2
L23:	SKIPGE PLTR
;;	JRST L2
	JRST L9
	MOVE	T,@1(16)
	CAMG	T,DPY+1
	JRST	L333
	MOVEM	T,DPY+1  ;  IF(B.LT.BOT)BOT=B
	JRA	16,3(16)
L333:	CAMG	T,DPY+2
	MOVEM	T,DPY+2
	JRA	16,3(16)  ;	IF(B.GT.TOP)TOP=B
			;2	IF(IPLT.EQ.-2)RETURN
;;L2:   	MOVNI T,2
;;	CAMN T,PLTR
;;	JRA 16,3(16)
			;9	M=ROFF(A*DIS)
L9:   	MOVE M,@(16)
	FMPR M,PLTR+2
	SKIPGE M
	FADR M,[-=1.0]
	FADR M,[=0.5]
	FIXX(M)
	MOVEM M,MM#
			;	N=ROFF(B*RHT)
	MOVE NX,@1(16)
	FMPR NX,PLTR+1
	SKIPGE NX
	FADR NX,[-=1.0]
	FADR NX,[=0.5]
	FIXX(NX)
	MOVEM NX,NN#
			;8	CALL PLOT(M,N,L)
L8:	MOVE T,@2(16)
	MOVEM T,LL#
	JSA 16,PLOT
	JUMP MM
	JUMP NN
	JUMP LL
			;	END
	JRA 16,3(16)

	EXTERNAL OUTF,PUTFIL,FASTOU,FINFIL,EXIT,PAC
LX:	0
N:	BLOCK =128
PLOT:	0		;SUBROUTINE PLOT(I,J,K)
	MOVE	4,OUTF		;COMMON /OUTF/JJ
	CAMN	4,[-1]		;DIMENSION N(148)
	JRST	PL4		;IF(JJ.EQ.-1)GO TO 4
	MOVEI	7,1		;L=1
	MOVEM	7,LX
	MOVEI	4,=127		;N(1)=127
	MOVEM	4,N
	MOVE	4,[ASCIZ/" "/]		;IF(JJ.EQ.' ')JJ='PLT'
	CAME	4,OUTF
	JRST	PLB
	MOVE	4,[ASCIZ/"PLT"/]
	MOVEM	4,OUTF
PLB:	JSA	16,PUTFIL	;CALL PUTFIL(JJ)
	JUMP	OUTF
	SETOM	OUTF		;JJ=-1
PL4:	MOVE	5,@2(16)	;4	IF(K.EQ.99)GO TO 1
	CAIN	5,=99
	JRST	PL1
	AOS	LX		;L=L+1
	MOVEI	7,N
	ADD	7,LX		;CALL PAC(N(L),I)[SEE MSFAI.FAI]
	HRRZ	4,2(16)
	HRR	5,@4
	LSHC	5,-10
	HRRZ	4,1(16)
	HRR	5,@4
	LSHC	5,-16
	HRRZ	4,(16)
	HRR	5,@4
	LSHC	5,-16
	MOVEM	6,-1(7)

	MOVE	7,LX
	CAIGE	7,=128	;3	IF(L.LT.128)RETURN
	JRA	16,3(16)
	JSA	16,FASTOU	;2	CALL FASTOU(N,128)
	JUMP	N
	JUMP	[=128]
	MOVEI	7,1		;L=1
	MOVEM	7,LX
	JRA	16,3(16)	;RETURN
PL1:	MOVE	5,LX		;1	N(1)=L
	MOVEM	5,N
	MOVEI	7,N		;J=N(L)
	ADD	7,5
	MOVE	7,-1(7)
	MOVEM	7,@1(16)
PL100:	MOVEI	4,N		;DO 100 JJ=L,128
	ADD	4,5	;100	N(JJ)=J
	MOVEM	7,-1(4)
	CAIGE	5,=128
	AOJA	5,PL100
	JSA	16,FASTOU	;CALL FASTOU(N,128)
	JUMP	N
	JUMP	[=128]
	JSA	16,FINFIL	;CALL FINFIL
	SETZM	OUTF		;JJ=0
	JSA	16,EXIT		;CALL EXIT

PLOTS:	0
	JRA	16,1(16)	; DUMMY ROUTINE
	END